home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / src / editcommands.c < prev    next >
C/C++ Source or Header  |  1995-03-09  |  27KB  |  1,000 lines
  1. /* editcommands.c -- Lisp functions for editing
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING.    If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22.  
  23. #include <string.h>
  24. #include <ctype.h>
  25.  
  26. #ifdef NEED_MEMORY_H
  27. # include <memory.h>
  28. #endif
  29.  
  30. _PR void edit_init(void);
  31.  
  32. static VALUE sym_upcase_table, sym_downcase_table;
  33.  
  34. _PR VALUE sym_inhibit_read_only;
  35. VALUE sym_inhibit_read_only;
  36.  
  37. /* Some doc strings
  38. ::doc:upcase_table::
  39. 256-byte string holding translations to turn each character into its
  40. upper-case equivalent.
  41. ::end::
  42. ::doc:downcase_table::
  43. 256-byte string holding translations to turn each character into its
  44. lower-case equivalent.
  45. ::end::
  46. ::doc:inhibit_read_only::
  47. When bound and non-nil this variable cancels the effect of the set-buffer-
  48. read-only command; in that the buffer is always writeable. This is
  49. intended to be bound while a command is executing that is allowed to
  50. modify a buffer.
  51. ::end:: */
  52.  
  53. _PR VALUE cmd_split_line(void);
  54. DEFUN_INT("split-line", cmd_split_line, subr_split_line, (void), V_Subr0, DOC_split_line, "") /*
  55. ::doc:split_line::
  56. split-line
  57.  
  58. Splits the line into two at the cursor position.
  59. ::end:: */
  60. {
  61.     VW *vw = curr_vw;
  62.     TX *tx = vw->vw_Tx;
  63.     if(!read_only(tx))
  64.     {
  65.     POS old = vw->vw_CursorPos;
  66.     if(pad_cursor(vw))
  67.     {
  68.         if(split_line(tx, &vw->vw_CursorPos))
  69.         {
  70.         undo_record_insertion(tx, &old, &vw->vw_CursorPos);
  71.         flag_insertion(tx, &old, &vw->vw_CursorPos);
  72.         return(sym_t);
  73.         }
  74.     }
  75.     }
  76.     return(sym_nil);
  77. }
  78.  
  79. _PR VALUE cmd_insert(VALUE string, VALUE pos, VALUE buff);
  80. DEFUN_INT("insert", cmd_insert, subr_insert, (VALUE string, VALUE lpos, VALUE buff), V_Subr3, DOC_insert, "sString to insert:") /*
  81. ::doc:insert::
  82. insert STRING [POS] [BUFFER]
  83.  
  84. Inserts STRING into BUFFER at POS. Returns the first position of the first
  85. character after the end of the inserted text.
  86. ::end:: */
  87. {
  88.     POS pos;
  89.     DECLARE1(string, STRINGP);
  90.     if(POSP(lpos))
  91.     pos = VPOS(lpos);
  92.     else
  93.     pos = curr_vw->vw_CursorPos;
  94.     if(!BUFFERP(buff))
  95.     buff = VAL(curr_vw->vw_Tx);
  96.     if(!read_only(VTX(buff)) && pad_pos(VTX(buff), &pos))
  97.     {
  98.     if(insert_string(VTX(buff), VSTR(string), STRING_LEN(string), &pos))
  99.         return(make_lpos(&pos));
  100.     }
  101.     return(sym_nil);
  102. }
  103.  
  104. _PR VALUE cmd_delete_area(VALUE start, VALUE end, VALUE buff);
  105. DEFUN("delete-area", cmd_delete_area, subr_delete_area, (VALUE lstart, VALUE lend, VALUE buff), V_Subr3, DOC_delete_area) /*
  106. ::doc:delete_area::
  107. delete-area START-POS END-POS [BUFFER]
  108.  
  109. Deletes from START-POS up to (but not including) END-POS.
  110. ::end:: */
  111. {
  112.     POS start, end;
  113.     DECLARE1(lstart, POSP);
  114.     DECLARE2(lend, POSP);
  115.     start = VPOS(lstart);
  116.     end = VPOS(lend);
  117.     if(!BUFFERP(buff))
  118.     buff = VAL(curr_vw->vw_Tx);
  119.     if(!read_only(VTX(buff)) && pad_pos(VTX(buff), &start)
  120.        && pad_pos(VTX(buff), &end) && check_section(VTX(buff), &start, &end))
  121.     {
  122.     delete_section(VTX(buff), &start, &end);
  123.     return(sym_t);
  124.     }
  125.     return(sym_nil);
  126. }
  127.  
  128. _PR VALUE cmd_copy_area(VALUE lstart, VALUE lend, VALUE buff);
  129. DEFUN("copy-area", cmd_copy_area, subr_copy_area, (VALUE lstart, VALUE lend, VALUE buff), V_Subr3, DOC_copy_area) /*
  130. ::doc:copy_area::
  131. copy-area START-POS END-POS [BUFFER]
  132.  
  133. Returns the string from START-POS up to END-POS.
  134. ::end:: */
  135. {
  136.     POS start, end;
  137.     DECLARE1(lstart, POSP);
  138.     DECLARE2(lend, POSP);
  139.     start = VPOS(lstart);
  140.     end = VPOS(lend);
  141.     if(!BUFFERP(buff))
  142.     buff = VAL(curr_vw->vw_Tx);
  143.     if(check_section(VTX(buff), &start, &end))
  144.     {
  145.     long tlen = section_length(VTX(buff), &start, &end) + 1;
  146.     VALUE str = make_string(tlen);
  147.     if(str)
  148.     {
  149.         copy_section(VTX(buff), &start, &end, VSTR(str));
  150.         VSTR(str)[tlen - 1] = 0;
  151.         return(str);
  152.     }
  153.     }
  154.     return(sym_nil);
  155. }
  156.  
  157. _PR VALUE cmd_cut_area(VALUE lstart, VALUE lend, VALUE buff);
  158. DEFUN("cut-area", cmd_cut_area, subr_cut_area, (VALUE lstart, VALUE lend, VALUE buff), V_Subr3, DOC_cut_area) /*
  159. ::doc:cut_area::
  160. cut-area START-POS END-POS [BUFFER]
  161.  
  162. The same as `copy-area' except that the section of text copied (START-POS to
  163. END-POS) is deleted from the file after being duplicated.
  164. ::end:: */
  165. {
  166.     POS start, end;
  167.     DECLARE1(lstart, POSP);
  168.     DECLARE2(lend, POSP);
  169.     start = VPOS(lstart);
  170.     end = VPOS(lend);
  171.     if(!BUFFERP(buff))
  172.     buff = VAL(curr_vw->vw_Tx);
  173.     if(!read_only(VTX(buff)) && pad_pos(VTX(buff), &start)
  174.        && pad_pos(VTX(buff), &end) && check_section(VTX(buff), &start, &end))
  175.     {
  176.     /* Only one copy is made. */
  177.     VALUE str = undo_push_deletion(VTX(buff), &start, &end);
  178.     if(str)
  179.     {
  180.         delete_section(VTX(buff), &start, &end);
  181.         return(str);
  182.     }
  183.     }
  184.     return(sym_nil);
  185. }
  186.  
  187. _PR VALUE cmd_block_toggle(void);
  188. DEFUN_INT("block-toggle", cmd_block_toggle, subr_block_toggle, (void), V_Subr0, DOC_block_toggle, "") /*
  189. ::doc:block_toggle::
  190. block-toggle
  191. ::end:: */
  192. {
  193.     VW *vw = curr_vw;
  194.     switch(vw->vw_BlockStatus)
  195.     {
  196.     case 0:
  197.         vw->vw_BlockStatus = -1;
  198.         set_block_refresh(vw);
  199.         break;
  200.     case 1:
  201.         vw->vw_BlockE = vw->vw_CursorPos;
  202.         vw->vw_BlockStatus = 0;
  203.         order_block(vw);
  204.         set_block_refresh(vw);
  205.         break;
  206.     case 2:
  207.         vw->vw_BlockS = vw->vw_CursorPos;
  208.         vw->vw_BlockStatus = 0;
  209.         order_block(vw);
  210.         set_block_refresh(vw);
  211.         break;
  212.     case -1:
  213.         vw->vw_BlockS = vw->vw_CursorPos;
  214.         vw->vw_BlockStatus = 1;
  215.         break;
  216.     }
  217.     return(sym_t);
  218. }
  219.  
  220. _PR VALUE cmd_block_start(VALUE pos);
  221. DEFUN("block-start", cmd_block_start, subr_block_start, (VALUE pos), V_Subr1, DOC_block_start) /*
  222. ::doc:block_start::
  223. block-start [POS]
  224.  
  225. Always returns the position of the block-start as it is, if POS is given
  226. it is used as the new position of the start of the block.
  227. ::end:: */
  228. {
  229.     VW *vw = curr_vw;
  230.     VALUE res;
  231.     if(!vw->vw_BlockStatus || (vw->vw_BlockStatus == 1))
  232.     res = make_lpos(&vw->vw_BlockS);
  233.     else
  234.     res = sym_nil;
  235.     if(POSP(pos) && check_line(vw->vw_Tx, &VPOS(pos)))
  236.     {
  237.     switch(vw->vw_BlockStatus)
  238.     {
  239.         case 0:
  240.         set_block_refresh(vw);
  241.         vw->vw_BlockS = VPOS(pos);
  242.         order_block(vw);
  243.         set_block_refresh(vw);
  244.         break;
  245.         case 2:
  246.         vw->vw_BlockS = VPOS(pos);
  247.         vw->vw_BlockStatus = 0;
  248.         order_block(vw);
  249.         set_block_refresh(vw);
  250.         break;
  251.         case -1:
  252.         vw->vw_BlockStatus = 1;
  253.         /* FALL THROUGH */
  254.         case 1:
  255.         vw->vw_BlockS = VPOS(pos);
  256.         break;
  257.     }
  258.     }
  259.     return(res);
  260. }
  261.  
  262. _PR VALUE cmd_block_end(VALUE pos);
  263. DEFUN("block-end", cmd_block_end, subr_block_end, (VALUE pos), V_Subr1, DOC_block_end) /*
  264. ::doc:block_end::
  265. block-end [POS]
  266.  
  267. Always returns the position of the block-end as it is, if POS is given
  268. it is used as the new position of the end of the block.
  269. ::end:: */
  270. {
  271.     VW *vw = curr_vw;
  272.     VALUE res;
  273.     if(!vw->vw_BlockStatus || (vw->vw_BlockStatus == 2))
  274.     res = make_lpos(&vw->vw_BlockE);
  275.     else
  276.     res = sym_nil;
  277.     if(POSP(pos) && check_line(vw->vw_Tx, &VPOS(pos)))
  278.     {
  279.     switch(vw->vw_BlockStatus)
  280.     {
  281.         case 0:
  282.         set_block_refresh(vw);
  283.         vw->vw_BlockE = VPOS(pos);
  284.         order_block(vw);
  285.         set_block_refresh(vw);
  286.         break;
  287.         case 1:
  288.         vw->vw_BlockE = VPOS(pos);
  289.         vw->vw_BlockStatus = 0;
  290.         order_block(vw);
  291.         set_block_refresh(vw);
  292.         break;
  293.         case -1:
  294.         vw->vw_BlockStatus = 2;
  295.         /* FALL THROUGH */
  296.         case 2:
  297.         vw->vw_BlockE = VPOS(pos);
  298.         break;
  299.     }
  300.     }
  301.     return(res);
  302. }
  303.  
  304. _PR VALUE cmd_block_kill(void);
  305. DEFUN_INT("block-kill", cmd_block_kill, subr_block_kill, (void), V_Subr0, DOC_block_kill, "") /*
  306. ::doc:block_kill::
  307. block-kill
  308.  
  309. Unmarks the block.
  310. ::end:: */
  311. {
  312.     VW *vw = curr_vw;
  313.     if(vw->vw_BlockStatus == 0)
  314.     {
  315.     set_block_refresh(vw);
  316.     vw->vw_BlockStatus = -1;
  317.     }
  318.     return(sym_t);
  319. }
  320.  
  321. _PR VALUE cmd_blockp(void);
  322. DEFUN("blockp", cmd_blockp, subr_blockp, (void), V_Subr0, DOC_blockp) /*
  323. ::doc:blockp::
  324. blockp
  325.  
  326. Returns true if a block is currently marked.
  327. ::end:: */
  328. {
  329.     if(curr_vw->vw_BlockStatus == 0)
  330.     return(sym_t);
  331.     return(sym_nil);
  332. }
  333.  
  334. _PR VALUE cmd_translate_area(VALUE vstart, VALUE vend, VALUE table, VALUE tx);
  335. DEFUN("translate-area", cmd_translate_area, subr_translate_area, (VALUE vstart, VALUE vend, VALUE table, VALUE tx), V_Subr4, DOC_translate_area) /*
  336. ::doc:translate_area:
  337. translate-area START-POS END-POS TRANSLATION-TABLE [BUFFER]
  338.  
  339. Applies the TRANSLATION-TABLE to the text between START-POS and END-POS.
  340. TRANSLATION-TABLE is a string, each character represents the translation
  341. for an ascii character of that characters position in the string. If the
  342. string is less than 256 chars long any undefined characters will remain
  343. unchanged.
  344. ::end:: */
  345. {
  346.     POS start, end;
  347.     if(!BUFFERP(tx))
  348.     tx = VAL(curr_vw->vw_Tx);
  349.     DECLARE1(vstart, POSP);
  350.     DECLARE2(vend, POSP);
  351.     DECLARE3(table, STRINGP);
  352.     start = VPOS(vstart);
  353.     end = VPOS(vend);
  354.     if(!read_only(VTX(tx)) && check_section(VTX(tx), &start, &end))
  355.     {
  356.     LINE *line = VTX(tx)->tx_Lines + start.pos_Line;
  357.     int tablen = STRING_LEN(table);
  358.     register u_char *str;
  359.     undo_record_modification(VTX(tx), &start, &end);
  360.     flag_modification(VTX(tx), &start, &end);
  361.     while(start.pos_Line < end.pos_Line)
  362.     {
  363.         int llen = line->ln_Strlen - 1;
  364.         str = line->ln_Line + start.pos_Col;
  365.         while(start.pos_Col++ < llen)
  366.         {
  367.         register u_char c = *str;
  368.         *str++ = (c < tablen) ? VSTR(table)[c] : c;
  369.         }
  370.         start.pos_Col = 0;
  371.         start.pos_Line++;
  372.         line++;
  373.     }
  374.     str = line->ln_Line + start.pos_Col;
  375.     while(start.pos_Col++ < end.pos_Col)
  376.     {
  377.         register u_char c = *str;
  378.         *str++ = (c < tablen) ? VSTR(table)[c] : c;
  379.     }
  380.     return(sym_t);
  381.     }
  382.     return(NULL);
  383. }
  384.  
  385. _PR VALUE cmd_translate_string(VALUE string, VALUE table);
  386. DEFUN("translate-string", cmd_translate_string, subr_translate_string, (VALUE string, VALUE table), V_Subr2, DOC_translate_string) /*
  387. ::doc:translate_string:
  388. translate-string STRING TRANSLATION-TABLE
  389.  
  390. Applies the TRANSLATION-TABLE to each character in the string STRING.
  391. TRANSLATION-TABLE is a string, each character represents the translation
  392. for an ascii character of that characters position in the string. If the
  393. string is less than 256 chars long any undefined characters will remain
  394. unchanged.
  395. Note that the STRING really is modified, no copy is made!
  396. ::end:: */
  397. {
  398.     int tablen, slen;
  399.     register u_char *str;
  400.     DECLARE1(string, STRINGP);
  401.     DECLARE2(table, STRINGP);
  402.     tablen = STRING_LEN(table);
  403.     if(!STRING_WRITEABLE_P(string))
  404.     return(signal_arg_error(string, 1));
  405.     str = VSTR(string);
  406.     slen = STRING_LEN(string);
  407.     while(slen-- > 0)
  408.     {
  409.     register u_char c = *str;
  410.     *str++ = (c < tablen) ? VSTR(table)[c] : c;
  411.     }
  412.     return(string);
  413. }
  414.  
  415. _PR VALUE cmd_get_char(VALUE vpos, VALUE tx);
  416. DEFUN("get-char", cmd_get_char, subr_get_char, (VALUE vpos, VALUE tx), V_Subr2, DOC_get_char) /*
  417. ::doc:get_char::
  418. get-char [POS] [BUFFER]
  419.  
  420. Returns the numerical value of the character at position POS in BUFFER. If no
  421. character exists at that position, nil is returned.
  422. ::end:: */
  423. {
  424.     POS pos;
  425.     LINE *line;
  426.     if(!BUFFERP(tx))
  427.     tx = VAL(curr_vw->vw_Tx);
  428.     if(POSP(vpos))
  429.     pos = VPOS(vpos);
  430.     else
  431.     pos = *(get_tx_cursor(VTX(tx)));
  432.     if(!check_line(VTX(tx), &pos))
  433.     return(sym_nil);
  434.     line = VTX(tx)->tx_Lines + pos.pos_Line;
  435.     if(pos.pos_Col >= line->ln_Strlen)
  436.     return(sym_nil);
  437.     else if(pos.pos_Col == line->ln_Strlen - 1)
  438.     {
  439.     if(pos.pos_Line == VTX(tx)->tx_NumLines - 1)
  440.         return(sym_nil);
  441.     else
  442.         return(make_number('\n'));
  443.     }
  444.     else
  445.     return(make_number(line->ln_Line[pos.pos_Col]));
  446. }
  447.  
  448. _PR VALUE cmd_set_char(VALUE ch, VALUE vpos, VALUE tx);
  449. DEFUN_INT("set-char", cmd_set_char, subr_set_char, (VALUE ch, VALUE vpos, VALUE tx), V_Subr3, DOC_set_char, "cCharacter:") /*
  450. ::doc:set_char::
  451. set-char CHARACTER [POS] [BUFFER]
  452.  
  453. Sets the character at position POS in BUFFER to CHARACTER.
  454. ::end:: */
  455. {
  456.     POS pos, end;
  457.     DECLARE1(ch, CHARP);
  458.     if(!BUFFERP(tx))
  459.     tx = VAL(curr_vw->vw_Tx);
  460.     if(POSP(vpos))
  461.     pos = VPOS(vpos);
  462.     else
  463.     pos = *(get_tx_cursor(VTX(tx)));
  464.     if(!check_line(VTX(tx), &pos))
  465.     return(sym_nil);
  466.     end.pos_Col = pos.pos_Col + 1;
  467.     end.pos_Line = pos.pos_Line;
  468.     if(pad_pos(VTX(tx), &end))
  469.     {
  470.     LINE *line = VTX(tx)->tx_Lines + pos.pos_Line;
  471.     undo_record_modification(VTX(tx), &pos, &end);
  472.     line->ln_Line[pos.pos_Col] = VCHAR(ch);
  473.     flag_modification(VTX(tx), &pos, &end);
  474.     return(ch);
  475.     }
  476.     return(NULL);
  477. }
  478.  
  479. _PR VALUE cmd_alpha_char_p(VALUE ch);
  480. DEFUN("alpha-char-p", cmd_alpha_char_p, subr_alpha_char_p, (VALUE ch), V_Subr1, DOC_alpha_char_p) /*
  481. ::doc:alpha_char_p::
  482. alpha-char-p CHAR
  483.  
  484. Returns t if CHAR is an alphabetic character.
  485. ::end:: */
  486. {
  487.     if(CHARP(ch) && isalpha(VCHAR(ch)))
  488.     return(sym_t);
  489.     return(sym_nil);
  490. }
  491.  
  492. _PR VALUE cmd_upper_case_p(VALUE ch);
  493. DEFUN("upper-case-p", cmd_upper_case_p, subr_upper_case_p, (VALUE ch), V_Subr1, DOC_upper_case_p) /*
  494. ::doc:upper_case_p::
  495. upper-case-p CHAR
  496.  
  497. Returns t if CHAR is upper case.
  498. ::end:: */
  499. {
  500.     if(CHARP(ch) && isupper(VCHAR(ch)))
  501.     return(sym_t);
  502.     return(sym_nil);
  503. }
  504.  
  505. _PR VALUE cmd_lower_case_p(VALUE ch);
  506. DEFUN("lower-case-p", cmd_lower_case_p, subr_lower_case_p, (VALUE ch), V_Subr1, DOC_lower_case_p) /*
  507. ::doc:lower_case_p::
  508. lower-case-p CHAR
  509.  
  510. Returns t if CHAR is lower case.
  511. ::end:: */
  512. {
  513.     if(CHARP(ch) && islower(VCHAR(ch)))
  514.     return(sym_t);
  515.     return(sym_nil);
  516. }
  517.  
  518. _PR VALUE cmd_digit_char_p(VALUE ch);
  519. DEFUN("digit-char-p", cmd_digit_char_p, subr_digit_char_p, (VALUE ch), V_Subr1, DOC_digit_char_p) /*
  520. ::doc:digit_char_p::
  521. digit-char-p CHAR
  522.  
  523. Returns t if CHAR is a digit.
  524. ::end:: */
  525. {
  526.     if(CHARP(ch) && isdigit(VCHAR(ch)))
  527.     return(sym_t);
  528.     return(sym_nil);
  529. }
  530.  
  531. _PR VALUE cmd_alphanumericp(VALUE ch);
  532. DEFUN("alphanumericp", cmd_alphanumericp, subr_alphanumericp, (VALUE ch), V_Subr1, DOC_alphanumericp) /*
  533. ::doc:alphanumericp::
  534. alphanumericp CHAR
  535.  
  536. Returns t if CHAR is alpha-numeric.
  537. ::end:: */
  538. {
  539.     if(CHARP(ch) && isalnum(VCHAR(ch)))
  540.     return(sym_t);
  541.     return(sym_nil);
  542. }
  543.  
  544. _PR VALUE cmd_space_char_p(VALUE ch);
  545. DEFUN("space-char-p", cmd_space_char_p, subr_space_char_p, (VALUE ch), V_Subr1, DOC_space_char_p) /*
  546. ::doc:space_char_p::
  547. space-char-p CHAR
  548.  
  549. Returns t if CHAR is whitespace.
  550. ::end:: */
  551. {
  552.     if(CHARP(ch) && isspace(VCHAR(ch)))
  553.     return(sym_t);
  554.     return(sym_nil);
  555. }
  556.  
  557. _PR VALUE cmd_char_upcase(VALUE ch);
  558. DEFUN("char-upcase", cmd_char_upcase, subr_char_upcase, (VALUE ch), V_Subr1, DOC_char_upcase) /*
  559. ::doc:char_upcase::
  560. char-upcase CHAR
  561.  
  562. Returns the upper-case equivalent of CHAR.
  563. ::end:: */
  564. {
  565.     DECLARE1(ch, CHARP);
  566.     return(make_number(toupper(VCHAR(ch))));
  567. }
  568.  
  569. _PR VALUE cmd_char_downcase(VALUE ch);
  570. DEFUN("char-downcase", cmd_char_downcase, subr_char_downcase, (VALUE ch), V_Subr1, DOC_char_downcase) /*
  571. ::doc:char_downcase::
  572. char-downcase CHAR
  573.  
  574. Returns the lower-case equivalent of CHAR.
  575. ::end:: */
  576. {
  577.     DECLARE1(ch, CHARP);
  578.     return(make_number(toupper(VCHAR(ch))));
  579. }
  580.  
  581. _PR VALUE cmd_pos_line(VALUE pos);
  582. DEFUN("pos-line", cmd_pos_line, subr_pos_line, (VALUE pos), V_Subr1, DOC_pos_line) /*
  583. ::doc:pos_line::
  584. pos-line POS
  585.  
  586. Returns the line number which POS points to.
  587. ::end:: */
  588. {
  589.     DECLARE1(pos, POSP);
  590.     return(make_number(VPOS(pos).pos_Line));
  591. }
  592.  
  593. _PR VALUE cmd_pos_col(VALUE pos);
  594. DEFUN("pos-col", cmd_pos_col, subr_pos_col, (VALUE pos), V_Subr1, DOC_pos_col) /*
  595. ::doc:pos_col::
  596. pos-col POS
  597.  
  598. Return the column number which POS points to.
  599. ::end:: */
  600. {
  601.     DECLARE1(pos, POSP);
  602.     return(make_number(VPOS(pos).pos_Col));
  603. }
  604.  
  605. _PR VALUE cmd_set_pos_line(VALUE pos, VALUE line);
  606. DEFUN("set-pos-line", cmd_set_pos_line, subr_set_pos_line, (VALUE pos, VALUE line), V_Subr2, DOC_set_pos_line) /*
  607. ::doc:set_pos_line::
  608. set-pos-line POS LINE
  609.  
  610. Sets the line number of POS to LINE.
  611. ::end:: */
  612. {
  613.     DECLARE1(pos, POSP);
  614.     DECLARE2(line, NUMBERP);
  615.     VPOS(pos).pos_Line = VNUM(line);
  616.     return(line);
  617. }
  618.  
  619. _PR VALUE cmd_set_pos_col(VALUE pos, VALUE col);
  620. DEFUN("set-pos-col", cmd_set_pos_col, subr_set_pos_col, (VALUE pos, VALUE col), V_Subr2, DOC_set_pos_col) /*
  621. ::doc:set_pos_col::
  622. set-pos-col POS COL
  623.  
  624. Sets the column number of POS to COL.
  625. ::end:: */
  626. {
  627.     DECLARE1(pos, POSP);
  628.     DECLARE2(col, NUMBERP);
  629.     VPOS(pos).pos_Col = VNUM(col);
  630.     return(col);
  631. }
  632.  
  633. _PR VALUE cmd_posp(VALUE arg);
  634. DEFUN("posp", cmd_posp, subr_posp, (VALUE arg), V_Subr1, DOC_posp) /*
  635. ::doc:posp::
  636. posp ARG
  637.  
  638. Returns t if ARG is a position object.
  639. ::end:: */
  640. {
  641.     if(POSP(arg))
  642.     return(sym_t);
  643.     return(sym_nil);
  644. }
  645.  
  646. _PR VALUE cmd_cursor_pos(void);
  647. DEFUN("cursor-pos", cmd_cursor_pos, subr_cursor_pos, (void), V_Subr0, DOC_cursor_pos) /*
  648. ::doc:cursor_pos::
  649. cursor-pos
  650.  
  651. Returns the position of the cursor in the current window.
  652. ::end:: */
  653. {
  654.     return(make_lpos(&curr_vw->vw_CursorPos));
  655. }
  656.  
  657. _PR VALUE cmd_empty_line_p(VALUE lpos, VALUE tx);
  658. DEFUN("empty-line-p", cmd_empty_line_p, subr_empty_line_p, (VALUE lpos, VALUE tx), V_Subr2, DOC_empty_line_p) /*
  659. ::doc:empty_line_p::
  660. empty-line-p [POS] [BUFFER]
  661.  
  662. Returns t if the line pointer to by POS (or the cursor) in BUFFER is
  663. empty, ie, blank or only containing spaces.
  664. ::end:: */
  665. {
  666.     VW *vw = curr_vw;
  667.     POS pos;
  668.     LINE *line;
  669.     if(POSP(lpos))
  670.     pos = VPOS(lpos);
  671.     else
  672.     pos = vw->vw_CursorPos;
  673.     if(!BUFFERP(tx))
  674.     tx = VAL(vw->vw_Tx);
  675.     line = VTX(tx)->tx_Lines + pos.pos_Line;
  676.     if(line->ln_Strlen == 1)
  677.     return(sym_t);
  678.     else
  679.     {
  680.     u_char *s = line->ln_Line;
  681.     while(*s && isspace(*s))
  682.         s++;
  683.     if(!(*s))
  684.         return(sym_t);
  685.     }
  686.     return(sym_nil);
  687. }
  688.  
  689. _PR VALUE cmd_indent_pos(VALUE lpos, VALUE tx);
  690. DEFUN("indent-pos", cmd_indent_pos, subr_indent_pos, (VALUE lpos, VALUE tx), V_Subr2, DOC_indent_pos) /*
  691. ::doc:indent_pos::
  692. indent-pos [POS] [BUFFER]
  693.  
  694. Returns the glyph position of the first non-space character in the line
  695. pointed to by POS (or the cursor), in BUFFER.
  696. ::end:: */
  697. {
  698.     VW *vw = curr_vw;
  699.     POS pos;
  700.     long len;
  701.     u_char *line;
  702.     if(!BUFFERP(tx))
  703.     tx = VAL(vw->vw_Tx);
  704.     if(POSP(lpos) && check_line(VTX(tx), &VPOS(lpos)))
  705.     pos = VPOS(lpos);
  706.     else
  707.     pos = vw->vw_CursorPos;
  708.     line = VTX(tx)->tx_Lines[pos.pos_Line].ln_Line;
  709.     for(len = 0; *line && isspace(*line); len++, line++)
  710.     ;
  711.     len = glyph_col(VTX(tx), len, pos.pos_Line);
  712.     return(make_lpos2(len, pos.pos_Line));
  713. }
  714.  
  715. _PR VALUE cmd_set_indent_pos(VALUE indpos, VALUE tx, VALUE spaces_p);
  716. DEFUN("set-indent-pos", cmd_set_indent_pos, subr_set_indent_pos, (VALUE indpos, VALUE tx, VALUE spaces_p), V_Subr3, DOC_set_indent_pos) /*
  717. ::doc:set_indent_pos::
  718. set-indent-pos POS [BUFFER] [ONLY-SPACES]
  719.  
  720. Sets the indentation of the line pointed to by POS to the column pointed
  721. to by POS by putting the optimal sequence of TAB and SPC characters at the
  722. start of the line.
  723.  
  724. If ONLY-SPACES in non-nil no tab characters are used.
  725. ::end:: */
  726. {
  727.     DECLARE1(indpos, POSP);
  728.     if(!BUFFERP(tx))
  729.     tx = VAL(curr_vw->vw_Tx);
  730.     if((!read_only(VTX(tx))) && check_line(VTX(tx), &VPOS(indpos)))
  731.     {
  732.     LINE *line = VTX(tx)->tx_Lines + VPOS(indpos).pos_Line;
  733.     u_char *s = line->ln_Line;
  734.     POS pos = VPOS(indpos), end;
  735.     long oldind, diff;
  736.     long tabs, spaces;
  737.     while(*s && isspace(*s))
  738.         s++;
  739.     oldind = s - line->ln_Line;
  740.     if(NILP(spaces_p))
  741.     {
  742.         tabs = pos.pos_Col / VTX(tx)->tx_TabSize;
  743.         spaces = pos.pos_Col % VTX(tx)->tx_TabSize;
  744.     }
  745.     else
  746.     {
  747.         tabs = 0;
  748.         spaces = pos.pos_Col;
  749.     }
  750.     diff = oldind - (tabs + spaces);
  751.     pos.pos_Col = 0;
  752.     end.pos_Col = diff;
  753.     end.pos_Line = pos.pos_Line;
  754.     if(diff > 0)
  755.     {
  756.         undo_record_deletion(VTX(tx), &pos, &end);
  757.         delete_chars(VTX(tx), &pos, diff);
  758.         flag_deletion(VTX(tx), &pos, &end);
  759.         end.pos_Col = tabs + spaces;
  760.         undo_record_modification(VTX(tx), &pos, &end);
  761.         memset(line->ln_Line, '\t', tabs);
  762.         memset(line->ln_Line + tabs, ' ', spaces);
  763.         flag_modification(VTX(tx), &pos, &end);
  764.     }
  765.     else if(diff < 0)
  766.     {
  767.         diff = -diff;
  768.         end.pos_Col = diff;
  769.         insert_gap(VTX(tx), diff, &pos);
  770.         undo_record_insertion(VTX(tx), &pos, &end);
  771.         flag_insertion(VTX(tx), &pos, &end);
  772.         pos.pos_Col = diff;
  773.         end.pos_Col = tabs + spaces;
  774.         memset(line->ln_Line, '\t', tabs);
  775.         memset(line->ln_Line + tabs, ' ', spaces);
  776.         undo_record_modification(VTX(tx), &pos, &end);
  777.         flag_modification(VTX(tx), &pos, &end);
  778.     }
  779.     else
  780.     {
  781.         u_char *s = line->ln_Line;
  782.         long i;
  783.         end.pos_Col = tabs + spaces;
  784.         for(i = 0; i < tabs; i++)
  785.         {
  786.         if(*s++ != '\t')
  787.         {
  788.             undo_record_modification(VTX(tx), &pos, &end);
  789.             memset(line->ln_Line, '\t', tabs);
  790.             memset(line->ln_Line + tabs, ' ', spaces);
  791.             flag_modification(VTX(tx), &pos, &end);
  792.             return(indpos);
  793.         }
  794.         }
  795.         for(i = 0; i < spaces; i++)
  796.         {
  797.         if(*s++ != ' ')
  798.         {
  799.             pos.pos_Col = tabs;
  800.             undo_record_modification(VTX(tx), &pos, &end);
  801.             memset(line->ln_Line + tabs, ' ', spaces);
  802.             flag_modification(VTX(tx), &pos, &end);
  803.             return(indpos);
  804.         }
  805.         }
  806.         /* No modifications required. */
  807.     }
  808.     return(indpos);
  809.     }
  810.     return(sym_nil);
  811. }
  812.  
  813. _PR VALUE cmd_indent_to(VALUE col, VALUE spaces_p);
  814. DEFUN_INT("indent-to", cmd_indent_to, subr_indent_to, (VALUE col, VALUE spaces_p), V_Subr2, DOC_indent_to, "NIndent to column:") /*
  815. ::doc:indent_to::
  816. indent-to COLUMN [ONLY-SPACES]
  817.  
  818. Inserts enough tabs and spaces to move the cursor to glyph column COLUMN.
  819. If ONLY-SPACES is non-nil no tabs are used.
  820. COLUMN counts from zero.
  821. ::end:: */
  822. {
  823.     VW *vw = curr_vw;
  824.     TX *tx = vw->vw_Tx;
  825.     DECLARE1(col, NUMBERP);
  826.     if(!read_only(tx) && pad_cursor(vw))
  827.     {
  828.     int spaces, tabs;
  829.     long curr_col, dest_col;
  830.         calc_cursor_offset(vw);
  831.         curr_col = vw->vw_LastCursorOffset;
  832.         dest_col = VNUM(col);
  833.         if(dest_col <= curr_col)
  834.             return(sym_t);
  835.     if(NILP(spaces_p))
  836.     {
  837.         tabs = (dest_col / tx->tx_TabSize) - (curr_col / tx->tx_TabSize);
  838.         if(tabs == 0)
  839.         spaces = dest_col - curr_col;
  840.         else
  841.         spaces = dest_col - ((dest_col / tx->tx_TabSize) * tx->tx_TabSize);
  842.     }
  843.     else
  844.     {
  845.         tabs = 0;
  846.         spaces = dest_col - curr_col;
  847.     }
  848.     if(spaces + tabs > 0)
  849.     {
  850.         POS tmp = vw->vw_CursorPos;
  851.         if(insert_gap(tx, spaces + tabs, &tmp))
  852.         {
  853.         u_char *line = tx->tx_Lines[tmp.pos_Line].ln_Line;
  854.         memset(line + tmp.pos_Col, '\t', tabs);
  855.         memset(line + tmp.pos_Col + tabs, ' ', spaces);
  856.         undo_record_insertion(tx, &tmp, &vw->vw_CursorPos);
  857.         flag_insertion(tx, &tmp, &vw->vw_CursorPos);
  858.         return(col);
  859.         }
  860.     }
  861.     return(sym_nil);
  862.     }
  863.     return(NULL);
  864. }
  865.         
  866. _PR VALUE cmd_clear_buffer(VALUE tx);
  867. DEFUN_INT("clear-buffer", cmd_clear_buffer, subr_clear_buffer, (VALUE tx), V_Subr1, DOC_clear_buffer, "") /*
  868. ::doc:clear_buffer::
  869. clear-buffer [BUFFER]
  870.  
  871. Remove all text from BUFFER, leaving just one empty line.
  872. ::end:: */
  873. {
  874.     POS start, end;
  875.     if(!BUFFERP(tx))
  876.     tx = VAL(curr_vw->vw_Tx);
  877.     start.pos_Col = start.pos_Line = 0;
  878.     end.pos_Line = VTX(tx)->tx_NumLines - 1;
  879.     end.pos_Col = VTX(tx)->tx_Lines[end.pos_Line].ln_Strlen - 1;
  880.     undo_record_deletion(VTX(tx), &start, &end);
  881.     if(clear_line_list(VTX(tx)))
  882.     {
  883.     reset_all_views(VTX(tx));
  884.     return(tx);
  885.     }
  886.     return(sym_nil);
  887. }
  888.  
  889. _PR VALUE cmd_pos_to_offset(VALUE vpos, VALUE tx);
  890. DEFUN("pos-to-offset", cmd_pos_to_offset, subr_pos_to_offset, (VALUE vpos, VALUE tx), V_Subr2, DOC_pos_to_offset) /*
  891. ::doc:pos_to_offset::
  892. pos-to-offset [POS] [BUFFER]
  893.  
  894. Returns the number of characters (counting from zero) that POS (or the cursor)
  895. is from the beginning of the buffer.
  896. ::end:: */
  897. {
  898.     POS pos;
  899.     LINE *line;
  900.     long offset, line_num;
  901.     if(!BUFFERP(tx))
  902.     tx = VAL(curr_vw->vw_Tx);
  903.     if(POSP(vpos))
  904.     pos = VPOS(vpos);
  905.     else
  906.     pos = *get_tx_cursor(VTX(tx));
  907.     check_pos(VTX(tx), &pos);
  908.     line = VTX(tx)->tx_Lines;
  909.     for(offset = line_num = 0; line_num < pos.pos_Line; line++, line_num++)
  910.     offset += line->ln_Strlen; /* includes the theoretical '\n' */
  911.     offset += pos.pos_Col;
  912.     return(make_number(offset));
  913. }
  914.  
  915. _PR VALUE cmd_offset_to_pos(VALUE voffset, VALUE tx);
  916. DEFUN("offset-to-pos", cmd_offset_to_pos, subr_offset_to_pos, (VALUE voffset, VALUE tx), V_Subr2, DOC_offset_to_pos) /*
  917. ::doc:offset_to_pos::
  918. offset-to-pos OFFSET [BUFFER]
  919.  
  920. Returns the position which is OFFSET characters from the start of the buffer.
  921. ::end:: */
  922. {
  923.     POS pos;
  924.     long offset;
  925.     LINE *line;
  926.     DECLARE1(voffset, NUMBERP);
  927.     offset = VNUM(voffset);
  928.     if(!BUFFERP(tx))
  929.     tx = VAL(curr_vw->vw_Tx);
  930.     pos.pos_Col = 0;
  931.     pos.pos_Line = 0;
  932.     line = VTX(tx)->tx_Lines + pos.pos_Line;
  933.     while(offset >= line->ln_Strlen)
  934.     {
  935.     offset -= line->ln_Strlen;
  936.     pos.pos_Line++;
  937.     line++;
  938.     }
  939.     pos.pos_Col = offset;
  940.     return(make_lpos(&pos));
  941. }
  942.  
  943. void
  944. edit_init(void)
  945. {
  946.     int i;
  947.     ADD_SUBR(subr_split_line);
  948.     ADD_SUBR(subr_insert);
  949.     ADD_SUBR(subr_delete_area);
  950.     ADD_SUBR(subr_copy_area);
  951.     ADD_SUBR(subr_cut_area);
  952.     ADD_SUBR(subr_block_toggle);
  953.     ADD_SUBR(subr_block_start);
  954.     ADD_SUBR(subr_block_end);
  955.     ADD_SUBR(subr_block_kill);
  956.     ADD_SUBR(subr_blockp);
  957.     ADD_SUBR(subr_translate_area);
  958.     ADD_SUBR(subr_translate_string);
  959.     ADD_SUBR(subr_get_char);
  960.     ADD_SUBR(subr_set_char);
  961.     ADD_SUBR(subr_alpha_char_p);
  962.     ADD_SUBR(subr_upper_case_p);
  963.     ADD_SUBR(subr_lower_case_p);
  964.     ADD_SUBR(subr_digit_char_p);
  965.     ADD_SUBR(subr_alphanumericp);
  966.     ADD_SUBR(subr_space_char_p);
  967.     ADD_SUBR(subr_char_upcase);
  968.     ADD_SUBR(subr_char_downcase);
  969.     ADD_SUBR(subr_pos_line);
  970.     ADD_SUBR(subr_pos_col);
  971.     ADD_SUBR(subr_set_pos_line);
  972.     ADD_SUBR(subr_set_pos_col);
  973.     ADD_SUBR(subr_posp);
  974.     ADD_SUBR(subr_cursor_pos);
  975.     ADD_SUBR(subr_empty_line_p);
  976.     ADD_SUBR(subr_indent_pos);
  977.     ADD_SUBR(subr_set_indent_pos);
  978.     ADD_SUBR(subr_indent_to);
  979.     ADD_SUBR(subr_clear_buffer);
  980.     ADD_SUBR(subr_offset_to_pos);
  981.     ADD_SUBR(subr_pos_to_offset);
  982.  
  983.     INTERN(sym_upcase_table, "upcase-table");
  984.     DOC_VAR(sym_upcase_table, DOC_upcase_table);
  985.     VSYM(sym_upcase_table)->sym_Value = make_string(257);
  986.     INTERN(sym_downcase_table, "downcase-table");
  987.     DOC_VAR(sym_downcase_table, DOC_downcase_table);
  988.     VSYM(sym_downcase_table)->sym_Value = make_string(257);
  989.     for(i = 0; i < 256; i++)
  990.     {
  991.     VSTR(VSYM(sym_upcase_table)->sym_Value)[i] = toupper(i);
  992.     VSTR(VSYM(sym_downcase_table)->sym_Value)[i] = tolower(i);
  993.     }
  994.     VSTR(VSYM(sym_upcase_table)->sym_Value)[256] = 0;
  995.     VSTR(VSYM(sym_downcase_table)->sym_Value)[256] = 0;
  996.  
  997.     INTERN(sym_inhibit_read_only, "inhibit-read-only");
  998.     DOC_VAR(sym_inhibit_read_only, DOC_inhibit_read_only);
  999. }
  1000.